home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / EvalMod3.mi < prev    next >
Text File  |  1992-11-24  |  34KB  |  1,147 lines
  1. IMPLEMENTATION MODULE EvalMod3;
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15. IMPORT SYSTEM, System, IO, Tree;
  16. (* line 7 "" *)
  17.  
  18.  
  19. FROM SYSTEM    IMPORT ADR, TSIZE;
  20. FROM General    IMPORT Max;
  21. FROM DynArray    IMPORT MakeArray;
  22. FROM IO        IMPORT WriteS, WriteNl, WriteI, WriteB, StdOutput;
  23. FROM Texts    IMPORT WriteText;
  24. FROM Sets    IMPORT tSet, MakeSet, ReleaseSet, Include, Exclude, Minimum,
  25.             Maximum, IsElement, WriteSet, IsEmpty, Extract;
  26. FROM Relations    IMPORT IsRelated;
  27. FROM TreeMod1    IMPORT BSS;
  28. FROM TreeMod2    IMPORT GetIterator, Iterator, WriteLine;
  29. FROM EvalMod    IMPORT Class;
  30. FROM Errors    IMPORT Error, Short, MessageI;
  31. FROM Positions    IMPORT NoPosition;
  32. IMPORT EvalMod;
  33.  
  34. FROM Tree    IMPORT
  35.    NoTree    , tTree        , Referenced    , NoCodeClass    ,
  36.    Computed    , Reverse    , Write        , Read        ,
  37.    Inherited    , Synthesized    , Input        , Output    ,
  38.    Virtual    , Test        , Left        , Right        ,
  39.    HasOutput    , NonBaseComp    , Dummy        , Trace        ,
  40.    Demand    , Funct        , NoClass    , Options    ,
  41.    TreeRoot    , iModule    , iMain        , itTree    ,
  42.    ForallClasses, ForallAttributes, f        , WI    , WN    ,
  43.    ClassCount    , IdentifyClass    , IdentifyAttribute, 
  44.    tBitIndex    , tBitInfo    , iNoTree    , QueryTree    ;
  45.  
  46. VAR
  47.    i, i2, j, k, n, MaxBit, MaxInstCount, Check: SHORTCARD;
  48.    Node, Attr, ChildsClass    : tTree;
  49.    Success, IsStable        : BOOLEAN;
  50.    BitIndexSize            : LONGINT;
  51.    gBitIndex            : tBitIndex;
  52.    InhIndices            : tSet;
  53.    InhIndexSize            : LONGINT;
  54.    InhIndexCount        : POINTER TO ARRAY [1..1000000] OF SHORTCARD;
  55.  
  56. PROCEDURE GenCall (t: tTree; j: SHORTCARD);
  57.    BEGIN
  58.       WITH t^.Class.Instance^ [j] DO
  59.      IF ({Synthesized, Left} <= Properties) THEN
  60.         k := ToBit0 (t, j);
  61.         WriteS (f, "IFNOTIN ("); WN (k MOD BSS); WriteS (f, ", yyt^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ") "); 
  62.         WriteS (f, "yyS"); WN (k); WriteS (f, " (yyt); (* "); WI (Attribute^.Child.Name); WriteS (f, " *) END;"); WriteNl (f);
  63.      ELSIF ({Inherited, Left} <= Properties) THEN
  64.         k := ToBit0 (t, j);
  65.         WriteS (f, "IFNOTIN ("); WN (k MOD BSS); WriteS (f, ", yyt^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ") "); 
  66.    IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  67.         WriteS (f, "yyVisitParent (yyt); "); 
  68.         WriteS (f, "yyI [yyt^.yyHead.yyOffset + "); WN (k); WriteS (f, "](yyt^.yyHead.yyParent); (* "); 
  69.         WI (Attribute^.Child.Name); WriteS (f, " *) "); 
  70.         WriteS (f, 'yyWriteVisit (yyt^.yyHead.yyParent, "?"); END;'); WriteNl (f);
  71.    ELSE
  72.         WriteS (f, "yyI [yyt^.yyHead.yyOffset + "); WN (k); WriteS (f, "](yyt^.yyHead.yyParent); (* "); 
  73.         WI (Attribute^.Child.Name); WriteS (f, " *) END;"); WriteNl (f);
  74.    END;
  75.      ELSIF ({Inherited, Right} <= Properties) THEN
  76.         k := ToBit1 (Selector, j - t^.Class.AttrCount - Selector^.Child.InstOffset);
  77.         WriteS (f, "IFNOTIN ("); WN (k MOD BSS); WriteS (f, ", yyt^."); WI (Class^.Class.Name);
  78.         WriteS (f, "."); WI (Selector^.Child.Name); WriteS (f, "^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ") "); 
  79.         k := ToBit2 (t, Selector, j);
  80.         WriteS (f, "yyI"); WN (k); WriteS (f, " (yyt); (* "); WI (Selector^.Child.Name);
  81.         WriteS (f, ":"); WI (Attribute^.Child.Name); WriteS (f, " *) END;"); WriteNl (f);
  82.      ELSIF ({Synthesized, Right} <= Properties) THEN
  83.         k := ToBit1 (Selector, j - t^.Class.AttrCount - Selector^.Child.InstOffset);
  84.         WriteS (f, "IFNOTIN ("); WN (k MOD BSS); WriteS (f, ", yyt^."); WI (Class^.Class.Name);
  85.         WriteS (f, "."); WI (Selector^.Child.Name); WriteS (f, "^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ") "); 
  86.    IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  87.         WriteS (f, 'yyWriteVisit (yyt, "'); WI (Selector^.Child.Name); WriteS (f, '"); '); 
  88.         WriteS (f, "yyS"); WN (k);
  89.         WriteS (f, " (yyt^."); WI (Class^.Class.Name); WriteS (f, "."); WI (Selector^.Child.Name);
  90.         WriteS (f, "); (* "); WI (Selector^.Child.Name); WriteS (f, ":"); WI (Attribute^.Child.Name); WriteS (f, " *) "); 
  91.         WriteS (f, "yyVisitParent (yyt^."); WI (Class^.Class.Name); WriteS (f, "."); WI (Selector^.Child.Name); WriteS (f, "); END;"); WriteNl (f);
  92.    ELSE
  93.         WriteS (f, "yyS"); WN (k);
  94.         WriteS (f, " (yyt^."); WI (Class^.Class.Name); WriteS (f, "."); WI (Selector^.Child.Name);
  95.         WriteS (f, "); (* "); WI (Selector^.Child.Name); WriteS (f, ":"); WI (Attribute^.Child.Name); WriteS (f, " *) END;"); WriteNl (f);
  96.    END;
  97.      END;
  98.       END;
  99.    END GenCall;
  100.  
  101. PROCEDURE GenEvalAttr (t: tTree; i: INTEGER);
  102.    BEGIN
  103.       Class := t;
  104.       WITH t^.Class.Instance^ [i] DO
  105.    IF IsElement (ORD ('X'), Options) AND (Trace IN t^.Class.Properties) THEN
  106.      WriteS (f, 'yyWriteEval (yyt, "'); WI (Attribute^.Child.Name); WriteS (f, '");'); WriteNl (f);
  107.      IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  108.         GenEvaluator (Action);
  109.         EvalMod.GenEvaluator (Action); WriteNl (f);
  110.         IF Test IN Properties THEN
  111.            WriteS (f, "writeBOOLEAN (yyb) yyWriteNl;"); WriteNl (f);
  112.         ELSIF (Attribute^.Kind = Tree.Child) OR (Attribute^.Attribute.Type = itTree) THEN
  113.            WriteS (f, "write"); WI (itTree);
  114.            WriteS (f, " (yyt^."); WI (t^.Class.Name); WriteS (f, "."); WI (Attribute^.Child.Name); WriteS (f, ")"); WriteNl (f);
  115.         ELSE
  116.            WriteS (f, "write"); WI (Attribute^.Child.Type);
  117.            WriteS (f, " (yyt^."); WI (t^.Class.Name); WriteS (f, "."); WI (Attribute^.Child.Name); WriteS (f, ") yyWriteNl;"); WriteNl (f);
  118.         END;
  119.      ELSE
  120.         WriteS (f, "yyWriteNl;"); WriteNl (f);
  121.      END;
  122.    ELSIF IsElement (ORD ('Y'), Options) AND (Trace IN t^.Class.Properties) THEN
  123.      WriteS (f, 'yyWriteEval (yyt, "'); WI (Attribute^.Child.Name); WriteS (f, '");'); WriteNl (f);
  124.      IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  125.         GenEvaluator (Action);
  126.         EvalMod.GenEvaluator (Action);
  127.      END;
  128.    ELSE
  129.      IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  130.         GenEvaluator (Action);
  131.         EvalMod.GenEvaluator (Action);
  132.      END;
  133.    END;
  134.       END;
  135.    END GenEvalAttr;
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242. PROCEDURE yyAbort (yyFunction: ARRAY OF CHAR);
  243.  BEGIN
  244.   IO.WriteS (IO.StdError, 'Error: module EvalMod3, routine ');
  245.   IO.WriteS (IO.StdError, yyFunction);
  246.   IO.WriteS (IO.StdError, ' failed');
  247.   IO.WriteNl (IO.StdError);
  248.   Exit;
  249.  END yyAbort;
  250.  
  251. PROCEDURE yyIsEqual (yya, yyb: ARRAY OF SYSTEM.BYTE): BOOLEAN;
  252.  VAR yyi    : INTEGER;
  253.  BEGIN
  254.   FOR yyi := 0 TO INTEGER (HIGH (yya)) DO
  255.    IF yya [yyi] # yyb [yyi] THEN RETURN FALSE; END;
  256.   END;
  257.   RETURN TRUE;
  258.  END yyIsEqual;
  259.  
  260. PROCEDURE EvalImplMod (t: Tree.tTree);
  261.  VAR yyTempo: RECORD CASE : INTEGER OF
  262.  | 2: yyR2: RECORD
  263.   a: SHORTCARD;
  264.   END;
  265.  END; END;
  266.  BEGIN
  267.   IF t = Tree.NoTree THEN RETURN; END;
  268.   IF (t^.Kind = Tree.Ag) THEN
  269. (* line 130 "" *)
  270.      WITH t^.Ag DO
  271. (* line 130 "" *)
  272.       
  273.     MaxBit := 0;
  274.     MaxInstCount := 0;
  275.     ForallClasses (Classes, CompBitInfo);
  276.     MakeSet (InhIndices, MaxInstCount);
  277.     InhIndexSize := MaxInstCount;
  278.     MakeArray (InhIndexCount, InhIndexSize, TSIZE (SHORTCARD));
  279.     FOR i := 1 TO MaxInstCount DO InhIndexCount^ [i] := 0; END;
  280.     ForallClasses (Classes, CompInhIndices);
  281.     WriteS (f, "# define IFNOTIN(b, s) IF NOT (b IN s) THEN"); WriteNl (f);
  282.     WriteS (f, "# define REMOTE_SYN(i, b, c, n, t, a) n^.t.a"); WriteNl (f);
  283.     WriteS (f, "# define REMOTE_INH(i, b, k, n, t, a) n^.t.a"); WriteNl (f);
  284.     EvalMod.EvalImplHead (t);
  285.     WriteNl (f);
  286.     WriteS (f, "VAR yyI: ARRAY [0.."); WN (Maximum (InhIndices)); WriteS (f, "] OF "); WI (iMain); WriteS (f, ".tProcTree;"); WriteNl (f);
  287.     WriteNl (f);
  288.     WriteS (f, "PROCEDURE yyAbort (yyt: "); WI (iMain); WriteS (f, "."); WI (itTree); WriteS (f, ");"); WriteNl (f);
  289.     WriteS (f, " BEGIN"); WriteNl (f);
  290.     WriteS (f, "  IO.WriteS (IO.StdError, 'Error: module "); WI (EvalName); WriteS (f, ", cyclic dependencies');"); WriteNl (f);
  291.     WriteS (f, "  IO.WriteNl (IO.StdError);"); WriteNl (f);
  292.     WriteS (f, "  IO.CloseIO;"); WriteNl (f);
  293.     WriteS (f, "  "); WI (iMain); WriteS (f, ".yyExit;"); WriteNl (f);
  294.     WriteS (f, " END yyAbort;"); WriteNl (f);
  295.     WriteNl (f);
  296.       IF NOT IsElement (ORD ('9'), Options) THEN
  297.     WriteNl (f);
  298.     WriteS (f, "PROCEDURE Eval (yyt: "); WI (iMain); WriteS (f, "."); WI (itTree); WriteS (f, ");"); WriteNl (f);
  299.     WriteS (f, " BEGIN "); WI (iMain); WriteS (f, ".Init"); WI (iModule); WriteS (f, " (yyt); yyE (yyt); END Eval;"); WriteNl (f);
  300.       ELSE
  301.     WriteNl (f);
  302.     WriteS (f, "VAR xxStack: CARDINAL;"); WriteNl (f);
  303.     WriteNl (f);
  304.     WriteS (f, "PROCEDURE Eval (yyt: "); WI (iMain); WriteS (f, "."); WI (itTree); WriteS (f, ");"); WriteNl (f);
  305.     WriteS (f, " VAR xxHigh: BOOLEAN;"); WriteNl (f);
  306.     WriteS (f, " BEGIN"); WriteNl (f);
  307.     WriteS (f, "  xxStack := MAX (INTEGER);"); WriteNl (f);
  308.     WriteS (f, "  "); WI (iMain); WriteS (f, ".Init"); WI (iModule); WriteS (f, " (yyt); yyE (yyt);"); WriteNl (f);
  309.     WriteS (f, "  IO.WriteS (IO.StdOutput, 'Stacksize ');"); WriteNl (f);
  310.     WriteS (f, "  IO.WriteI (IO.StdOutput, CARDINAL (SYSTEM.ADR (xxHigh)) - xxStack, 0);"); WriteNl (f);
  311.     WriteS (f, "  IO.WriteNl (IO.StdOutput);"); WriteNl (f);
  312.     WriteS (f, " END Eval;"); WriteNl (f);
  313.       END;
  314.     WriteNl (f);
  315.     REPEAT IsStable := TRUE; ForallClasses (Classes, CompOutput); UNTIL IsStable;
  316.     WriteS (f, "PROCEDURE yyE (yyt: "); WI (iMain); WriteS (f, "."); WI (itTree); WriteS (f, ");"); WriteNl (f);
  317.     WriteLine (TreeRoot^.Ag.EvalCodes^.Codes.LocalLine);
  318.     WriteText (f, TreeRoot^.Ag.EvalCodes^.Codes.Local);
  319.     Node := TreeRoot^.Ag.Modules;
  320.     WHILE Node^.Kind = Tree.Module DO
  321.        WriteLine (Node^.Module.EvalCodes^.Codes.LocalLine);
  322.        WriteText (f, Node^.Module.EvalCodes^.Codes.Local);
  323.        Node := Node^.Module.Next;
  324.     END;
  325.       IF IsElement (ORD ('9'), Options) THEN
  326.     WriteS (f, " VAR xxLow: BOOLEAN;"); WriteNl (f);
  327.     WriteS (f, " BEGIN"); WriteNl (f);
  328.     WriteS (f, "  xxStack := General.Min (xxStack, CARDINAL (SYSTEM.ADR (xxLow)));"); WriteNl (f);
  329.       ELSE
  330.     WriteS (f, " BEGIN"); WriteNl (f);
  331.       END;
  332.     WriteS (f, "  LOOP"); WriteNl (f);
  333.     WriteS (f, "   IF (yyt = "); WI (iMain); WriteS (f, "."); WI (iNoTree); WriteS (f, ") OR (0 IN yyt^.yyHead.yyIsComp0) THEN RETURN; END;"); WriteNl (f);
  334.     WriteS (f, "   INCL (yyt^.yyHead.yyIsComp0, 0);"); WriteNl (f);
  335.     WriteS (f, "   CASE yyt^.Kind OF"); WriteNl (f);
  336.     ForallClasses (Classes, GenE);
  337.     WriteS (f, "   ELSE RETURN;"); WriteNl (f);
  338.     WriteS (f, "   END;"); WriteNl (f);
  339.     WriteS (f, "  END;"); WriteNl (f);
  340.     WriteS (f, " END yyE;"); WriteNl (f);
  341.     WriteNl (f);
  342.     FOR i := 2 TO MaxBit DO
  343.        n := 0;            (* are there any SYN attributes ? *)
  344.        ForallClasses (Classes, CountSynAttr);
  345.        IF n > 0 THEN
  346.           WriteS (f, "PROCEDURE yyS"); WN (i - 1); WriteS (f, " (yyt: "); WI (iMain); WriteS (f, "."); WI (itTree); WriteS (f, ");"); WriteNl (f);
  347.           WriteLine (TreeRoot^.Ag.EvalCodes^.Codes.LocalLine);
  348.           WriteText (f, TreeRoot^.Ag.EvalCodes^.Codes.Local);
  349.           Node := TreeRoot^.Ag.Modules;
  350.           WHILE Node^.Kind = Tree.Module DO
  351.          WriteLine (Node^.Module.EvalCodes^.Codes.LocalLine);
  352.          WriteText (f, Node^.Module.EvalCodes^.Codes.Local);
  353.          Node := Node^.Module.Next;
  354.           END;
  355.       IF IsElement (ORD ('9'), Options) THEN
  356.           WriteS (f, " VAR xxLow: BOOLEAN;"); WriteNl (f);
  357.           WriteS (f, " BEGIN"); WriteNl (f);
  358.           WriteS (f, "  xxStack := General.Min (xxStack, CARDINAL (SYSTEM.ADR (xxLow)));"); WriteNl (f);
  359.       ELSE
  360.           WriteS (f, " BEGIN"); WriteNl (f);
  361.       END;
  362.       IF IsElement (ORD ('5'), Options) THEN
  363.           WriteS (f, " IFNOTIN ("); WN ((i - 1) MOD BSS); WriteS (f, ", yyt^.yyHead.yyIsDone"); WN ((i - 1) DIV BSS);
  364.           WriteS (f, ") INCL (yyt^.yyHead.yyIsDone"); WN ((i - 1) DIV BSS); WriteS (f, ", "); WN ((i - 1) MOD BSS); WriteS (f, "); ELSE yyAbort (yyt); END;"); WriteNl (f);
  365.       END;
  366.           IF n > 1 THEN
  367.          WriteS (f, "  CASE yyt^.Kind OF"); WriteNl (f);
  368.          ForallClasses (Classes, GenS);
  369.          WriteS (f, "  END;"); WriteNl (f);
  370.           ELSE
  371.          ForallClasses (Classes, GenS);
  372.           END;
  373.           WriteS (f, "  INCL (yyt^.yyHead.yyIsComp"); WN ((i - 1) DIV BSS); WriteS (f, ", "); WN ((i - 1) MOD BSS); WriteS (f, ");"); WriteNl (f);
  374.           WriteS (f, " END yyS"); WN (i - 1); WriteS (f, ";"); WriteNl (f);
  375.           WriteNl (f);
  376.        END;
  377.     END;
  378.     FOR i := Minimum (InhIndices) TO Maximum (InhIndices) DO
  379.        IF IsElement (i, InhIndices) THEN
  380.           WriteS (f, "PROCEDURE yyI"); WN (i); WriteS (f, " (yyt: "); WI (iMain); WriteS (f, "."); WI (itTree); WriteS (f, ");"); WriteNl (f);
  381.           WriteLine (TreeRoot^.Ag.EvalCodes^.Codes.LocalLine);
  382.           WriteText (f, TreeRoot^.Ag.EvalCodes^.Codes.Local);
  383.           Node := TreeRoot^.Ag.Modules;
  384.           WHILE Node^.Kind = Tree.Module DO
  385.          WriteLine (Node^.Module.EvalCodes^.Codes.LocalLine);
  386.          WriteText (f, Node^.Module.EvalCodes^.Codes.Local);
  387.          Node := Node^.Module.Next;
  388.           END;
  389.       IF IsElement (ORD ('9'), Options) THEN
  390.           WriteS (f, " VAR xxLow: BOOLEAN;"); WriteNl (f);
  391.           WriteS (f, " BEGIN"); WriteNl (f);
  392.           WriteS (f, "  xxStack := General.Min (xxStack, CARDINAL (SYSTEM.ADR (xxLow)));"); WriteNl (f);
  393.       ELSE
  394.           WriteS (f, " BEGIN"); WriteNl (f);
  395.       END;
  396.           Check := 0;
  397.           IF InhIndexCount^ [i] > 1 THEN
  398.          WriteS (f, "  CASE yyt^.Kind OF"); WriteNl (f);
  399.          ForallClasses (Classes, EvalImplMod);
  400.          WriteS (f, "  END;"); WriteNl (f);
  401.           ELSE
  402.          ForallClasses (Classes, EvalImplMod);
  403.           END;
  404.           IF Check # InhIndexCount^ [i] THEN
  405.              MessageI ("internal error in yyI", Error, NoPosition, Short, ADR (i));
  406.           END;
  407.           WriteS (f, " END yyI"); WN (i); WriteS (f, ";"); WriteNl (f);
  408.           WriteNl (f);
  409.        END;
  410.     END;
  411.     WriteS (f, "PROCEDURE Begin"); WI (EvalName); WriteS (f, ";"); WriteNl (f);
  412.     WriteS (f, " BEGIN"); WriteNl (f);
  413.     WriteLine (EvalCodes^.Codes.BeginLine);
  414.     WriteText (f, EvalCodes^.Codes.Begin);
  415.     Node := Modules;
  416.     WHILE Node^.Kind = Tree.Module DO
  417.        WriteLine (Node^.Module.EvalCodes^.Codes.BeginLine);
  418.        WriteText (f, Node^.Module.EvalCodes^.Codes.Begin);
  419.        Node := Node^.Module.Next;
  420.     END;
  421.     WriteS (f, " END Begin"); WI (EvalName); WriteS (f, ";"); WriteNl (f);
  422.     WriteNl (f);
  423.     WriteS (f, "PROCEDURE Close"); WI (EvalName); WriteS (f, ";"); WriteNl (f);
  424.     WriteS (f, " BEGIN"); WriteNl (f);
  425.     WriteLine (EvalCodes^.Codes.CloseLine);
  426.     WriteText (f, EvalCodes^.Codes.Close);
  427.     Node := Modules;
  428.     WHILE Node^.Kind = Tree.Module DO
  429.        WriteLine (Node^.Module.EvalCodes^.Codes.CloseLine);
  430.        WriteText (f, Node^.Module.EvalCodes^.Codes.Close);
  431.        Node := Node^.Module.Next;
  432.     END;
  433.     WriteS (f, " END Close"); WI (EvalName); WriteS (f, ";"); WriteNl (f);
  434.     WriteNl (f);
  435.     WriteS (f, "BEGIN"); WriteNl (f);
  436.       IF IsElement (ORD ('X'), Options) THEN
  437.     WriteS (f, " yyf := IO.StdOutput;"); WriteNl (f);
  438.       END;
  439.     FOR i := Minimum (InhIndices) TO Maximum (InhIndices) DO
  440.        IF IsElement (i, InhIndices) THEN
  441.           WriteS (f, " yyI ["); WN (i); WriteS (f, "] := yyI"); WN (i); WriteS (f, ";"); WriteNl (f);
  442.        END;
  443.     END;
  444.     WriteS (f, "END "); WI (EvalName); WriteS (f, "."); WriteNl (f);
  445. ;
  446.       RETURN;
  447.      END;
  448.  
  449.   END;
  450.   IF (t^.Kind = Tree.Class) THEN
  451. (* line 304 "" *)
  452.     WITH yyTempo.yyR2 DO
  453.    LOOP
  454.      WITH t^.Class DO
  455. (* line 305 "" *)
  456.       IF NOT (NoCodeClass * Properties = {}) THEN EXIT; END;
  457. (* line 306 "" *)
  458.       IF NOT (i <= InstCount) THEN EXIT; END;
  459. (* line 307 "" *)
  460.       ;
  461. (* line 308 "" *)
  462.           a := ToAttr (t, i);
  463.     IF a = 0 THEN RETURN; END;
  464.     WITH Instance^ [a] DO
  465.        IF {Inherited, Right} <= Properties THEN
  466.           Class := t;
  467.           IF InhIndexCount^ [i] > 1 THEN
  468.          WriteS (f, "   | "); WI (iMain); WriteS (f, "."); WI (Name); WriteS (f, ":"); WriteNl (f);
  469.           END;
  470.           INC (Check);
  471.           k := ToBit1 (Selector, a - AttrCount - Selector^.Child.InstOffset);
  472.       IF IsElement (ORD ('5'), Options) THEN
  473.           WriteS (f, " IFNOTIN ("); WN (k MOD BSS); WriteS (f, ", yyt^."); WI (Class^.Class.Name);
  474.           WriteS (f, "."); WI (Selector^.Child.Name); WriteS (f, "^.yyHead.yyIsDone"); WN (k DIV BSS);
  475.           WriteS (f, ") INCL (yyt^."); WI (Class^.Class.Name); WriteS (f, "."); WI (Selector^.Child.Name);
  476.           WriteS (f, "^.yyHead.yyIsDone"); WN (k DIV BSS); WriteS (f, ", "); WN (k MOD BSS); WriteS (f, "); ELSE yyAbort (yyt); END;"); WriteNl (f);
  477.       END;
  478.           FOR j := 1 TO InstCount DO
  479.          IF IsRelated (a, j, DP) THEN
  480.             GenCall (t, j);
  481.          END;
  482.           END;
  483.       IF IsElement (ORD ('X'), Options) AND (Trace IN t^.Class.Properties) THEN
  484.           WriteS (f, 'yyWriteEval (yyt, "'); WI (Selector^.Child.Name); WriteS (f, ":"); WI (Attribute^.Child.Name); WriteS (f, '");'); WriteNl (f);
  485.           IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  486.          GenEvaluator (Action);
  487.          EvalMod.GenEvaluator (Action); WriteNl (f);
  488.          IF (Attribute^.Kind = Tree.Child) OR (Attribute^.Attribute.Type = itTree) THEN
  489.             WriteS (f, "write"); WI (itTree);
  490.             WriteS (f, " (yyt^."); WI (Name); WriteS (f, "."); WI (Selector^.Child.Name);
  491.             WriteS (f, "^."); WI (Selector^.Child.Type); WriteS (f, "."); WI (Attribute^.Child.Name); WriteS (f, ")"); WriteNl (f);
  492.          ELSE
  493.             WriteS (f, "write"); WI (Attribute^.Child.Type);
  494.             WriteS (f, " (yyt^."); WI (Name); WriteS (f, "."); WI (Selector^.Child.Name);
  495.             WriteS (f, "^."); WI (Selector^.Child.Type); WriteS (f, "."); WI (Attribute^.Child.Name); WriteS (f, ") yyWriteNl;"); WriteNl (f);
  496.          END;
  497.           ELSE
  498.          WriteS (f, "yyWriteNl;"); WriteNl (f);
  499.           END;
  500.       ELSIF IsElement (ORD ('Y'), Options) AND (Trace IN t^.Class.Properties) THEN
  501.           WriteS (f, 'yyWriteEval (yyt, "'); WI (Selector^.Child.Name); WriteS (f, ":"); WI (Attribute^.Child.Name); WriteS (f, '");'); WriteNl (f);
  502.           IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  503.          GenEvaluator (Action);
  504.          EvalMod.GenEvaluator (Action);
  505.           END;
  506.       ELSE
  507.           IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  508.          GenEvaluator (Action);
  509.          EvalMod.GenEvaluator (Action);
  510.           END;
  511.       END;
  512.           IF NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) THEN
  513.          WriteS (f, "WITH yyt^."); WI (Name); WriteS (f, "."); WI (Selector^.Child.Name);
  514.          WriteS (f, "^."); WI (Selector^.Child.Type); WriteS (f, "."); WI (Attribute^.Child.Name);
  515.          WriteS (f, "^.yyHead DO IF yyParent = "); WI (iMain); WriteS (f, "."); WI (iNoTree); WriteS (f, " THEN yyOffset := "); 
  516.          WN (Selector^.Child.Class^.Class.BitCount + Attribute^.Child.BitOffset);
  517.          WriteS (f, "; yyParent := yyt^."); WI (Name); WriteS (f, "."); WI (Selector^.Child.Name); WriteS (f, "; "); WriteNl (f);
  518.          WI (iMain); WriteS (f, ".Init"); WI (iModule); WriteS (f, " (yyt^."); WI (Name); WriteS (f, "."); WI (Selector^.Child.Name); 
  519.          WriteS (f, "^."); WI (Selector^.Child.Type); WriteS (f, "."); WI (Attribute^.Child.Name); WriteS (f, "); END; END;"); WriteNl (f);
  520.           END;
  521.           FOR i2 := 1 TO InstCount DO    (* add group members *)
  522.          IF Instance^[i2].Action = Action THEN
  523.             WITH Instance^[i2] DO
  524.                IF Synthesized IN Properties THEN
  525.               k := ToBit0 (Class, i2);
  526.               WriteS (f, "   INCL (yyt^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ", "); WN (k MOD BSS); WriteS (f, ");"); WriteNl (f);
  527.                ELSIF Inherited IN Properties THEN
  528.               k := ToBit1 (Selector, i2 - AttrCount - Selector^.Child.InstOffset);
  529.               WriteS (f, "   INCL (yyt^."); WI (Class^.Class.Name); WriteS (f, "."); WI (Selector^.Child.Name);
  530.               WriteS (f, "^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ", "); WN (k MOD BSS); WriteS (f, ");"); WriteNl (f);
  531.                END;
  532.             END;
  533.          END;
  534.           END;
  535.        END;
  536.     END;
  537. ;
  538.       RETURN;
  539.      END;
  540.    END;
  541.     END;
  542.  
  543.   END;
  544.  END EvalImplMod;
  545.  
  546. PROCEDURE CompBitInfo (t: Tree.tTree);
  547.  VAR yyTempo: RECORD CASE : INTEGER OF
  548.  END; END;
  549.  BEGIN
  550.   IF t = Tree.NoTree THEN RETURN; END;
  551.   IF (t^.Kind = Tree.Class) THEN
  552. (* line 387 "" *)
  553.      WITH t^.Class DO
  554. (* line 388 "" *)
  555.       BitIndexSize := AttrCount;
  556. (* line 389 "" *)
  557.       MakeArray (BitIndex, BitIndexSize, TSIZE (tBitInfo));
  558. (* line 390 "" *)
  559.       i := 1;
  560. (* line 391 "" *)
  561.       gBitIndex := BitIndex;
  562. (* line 392 "" *)
  563.       ForallAttributes (t, CompBitInfo);
  564. (* line 393 "" *)
  565.       MaxBit := Max (i, MaxBit);
  566. (* line 394 "" *)
  567.       MaxInstCount := Max (InstCount, MaxInstCount);
  568.       RETURN;
  569.      END;
  570.  
  571.   END;
  572.   IF (t^.Kind = Tree.Child) THEN
  573. (* line 396 "" *)
  574.    LOOP
  575.      WITH t^.Child DO
  576. (* line 398 "" *)
  577.       IF NOT (({Input, Test, Dummy} * Properties = {})) THEN EXIT; END;
  578. (* line 399 "" *)
  579.       INC (i);
  580. (* line 400 "" *)
  581.       gBitIndex ^ [AttrIndex] . ToBit := i;
  582. (* line 401 "" *)
  583.       gBitIndex ^ [i] . ToAttr := AttrIndex;
  584.       RETURN;
  585.      END;
  586.    END;
  587.  
  588.   END;
  589.   IF (t^.Kind = Tree.Attribute) THEN
  590. (* line 396 "" *)
  591.    LOOP
  592.      WITH t^.Attribute DO
  593. (* line 398 "" *)
  594.       IF NOT (({Input, Test, Dummy} * Properties = {})) THEN EXIT; END;
  595. (* line 399 "" *)
  596.       INC (i);
  597. (* line 400 "" *)
  598.       gBitIndex ^ [AttrIndex] . ToBit := i;
  599. (* line 401 "" *)
  600.       gBitIndex ^ [i] . ToAttr := AttrIndex;
  601.       RETURN;
  602.      END;
  603.    END;
  604.  
  605.   END;
  606.  END CompBitInfo;
  607.  
  608. PROCEDURE CompInhIndices (t: Tree.tTree);
  609.  VAR yyTempo: RECORD CASE : INTEGER OF
  610.  | 1: yyR1: RECORD
  611.   b: INTEGER;
  612.   END;
  613.  END; END;
  614.  BEGIN
  615.   IF t = Tree.NoTree THEN RETURN; END;
  616.   IF (t^.Kind = Tree.Class) THEN
  617. (* line 406 "" *)
  618.     WITH yyTempo.yyR1 DO
  619.      WITH t^.Class DO
  620. (* line 407 "" *)
  621.       ;
  622. (* line 408 "" *)
  623.           FOR j := AttrCount + 1 TO InstCount DO
  624.        WITH Instance^ [j] DO
  625.           IF Inherited IN Properties THEN
  626.          b := ToBit2 (t, Selector, j);
  627.          Include (InhIndices, b);
  628.          INC (InhIndexCount^ [b]);
  629.           END;
  630.        END;
  631.     END;
  632. ;
  633.       RETURN;
  634.      END;
  635.     END;
  636.  
  637.   END;
  638.  END CompInhIndices;
  639.  
  640. PROCEDURE CountSynAttr (t: Tree.tTree);
  641.  VAR yyTempo: RECORD CASE : INTEGER OF
  642.  END; END;
  643.  BEGIN
  644.   IF t = Tree.NoTree THEN RETURN; END;
  645.   IF (t^.Kind = Tree.Class) THEN
  646. (* line 421 "" *)
  647.    LOOP
  648.      WITH t^.Class DO
  649. (* line 422 "" *)
  650.       IF NOT (NoCodeClass * Properties = {}) THEN EXIT; END;
  651. (* line 423 "" *)
  652.       IF NOT (i <= BitCount) THEN EXIT; END;
  653. (* line 424 "" *)
  654.           WITH Instance^ [BitIndex^ [i].ToAttr] DO
  655.        IF ({Synthesized, Left} <= Properties) AND NOT (Test IN Properties) THEN
  656.           INC (n);
  657.        END;
  658.     END;
  659. ;
  660.       RETURN;
  661.      END;
  662.    END;
  663.  
  664.   END;
  665.  END CountSynAttr;
  666.  
  667. PROCEDURE WriteType (t: Tree.tTree);
  668.  VAR yyTempo: RECORD CASE : INTEGER OF
  669.  END; END;
  670.  BEGIN
  671.   IF t = Tree.NoTree THEN RETURN; END;
  672.   IF (t^.Kind = Tree.Class) THEN
  673. (* line 433 "" *)
  674.    LOOP
  675.      WITH t^.Class DO
  676. (* line 434 "" *)
  677.       IF NOT (NoCodeClass * Properties = {}) THEN EXIT; END;
  678. (* line 435 "" *)
  679.       IF NOT (Trace IN Properties) THEN EXIT; END;
  680. (* line 436 "" *)
  681.       WriteS (f, "| ");
  682. (* line 436 "" *)
  683.       WI (TreeRoot ^ . Ag . TreeName);
  684. (* line 436 "" *)
  685.       WriteS (f, ".");
  686. (* line 436 "" *)
  687.       WI (Name);
  688. (* line 436 "" *)
  689.       WriteS (f, ": yyWriteS ('");
  690. (* line 436 "" *)
  691.       WI (Name);
  692. (* line 436 "" *)
  693.       WriteS (f, "');");
  694. (* line 436 "" *)
  695.       WriteNl (f);
  696.       RETURN;
  697.      END;
  698.    END;
  699.  
  700.   END;
  701.  END WriteType;
  702.  
  703. PROCEDURE GenS (t: Tree.tTree);
  704.  VAR yyTempo: RECORD CASE : INTEGER OF
  705.  END; END;
  706.  BEGIN
  707.   IF t = Tree.NoTree THEN RETURN; END;
  708.   IF (t^.Kind = Tree.Class) THEN
  709. (* line 441 "" *)
  710.    LOOP
  711.      WITH t^.Class DO
  712. (* line 442 "" *)
  713.       IF NOT (NoCodeClass * Properties = {}) THEN EXIT; END;
  714. (* line 443 "" *)
  715.       IF NOT (i <= BitCount) THEN EXIT; END;
  716. (* line 444 "" *)
  717.           WITH Instance^ [BitIndex^ [i].ToAttr] DO
  718.        IF ({Synthesized, Left} <= Properties) AND NOT (Test IN Properties) THEN
  719.           Class := t;
  720.           IF n > 1 THEN
  721.          WriteS (f, "   | "); WI (iMain); WriteS (f, "."); WI (Name); WriteS (f, ":"); WriteNl (f);
  722.           END;
  723.           FOR j := 1 TO InstCount DO
  724.          IF IsRelated (BitIndex^ [i].ToAttr, j, DP) THEN
  725.             GenCall (t, j);
  726.          END;
  727.           END;
  728.           GenEvalAttr (t, BitIndex^ [i].ToAttr);
  729.           IF NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) THEN
  730.          WriteS (f, "WITH yyt^."); WI (Name); WriteS (f, "."); WI (Attribute^.Child.Name);
  731.          WriteS (f, "^.yyHead DO IF yyParent = "); WI (iMain); WriteS (f, "."); WI (iNoTree); WriteS (f, " THEN yyOffset := "); 
  732.          WN (BitCount + Attribute^.Child.BitOffset); WriteS (f, "; yyParent := yyt; "); 
  733.          WI (iMain); WriteS (f, ".Init"); WI (iModule); WriteS (f, " (yyt^."); WI (Name); WriteS (f, "."); WI (Attribute^.Child.Name); WriteS (f, "); END; END;"); WriteNl (f);
  734.           END;
  735.           FOR i2 := 1 TO InstCount DO    (* add group members *)
  736.          IF Instance^[i2].Action = Action THEN
  737.             WITH Instance^[i2] DO
  738.                IF Synthesized IN Properties THEN
  739.               k := ToBit0 (Class, i2);
  740.               IF k # i - 1 THEN
  741.                  WriteS (f, "   INCL (yyt^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ", "); WN (k MOD BSS); WriteS (f, ");"); WriteNl (f);
  742.               END;
  743.                ELSIF Inherited IN Properties THEN
  744.               k := ToBit1 (Selector, i2 - AttrCount - Selector^.Child.InstOffset);
  745.               WriteS (f, "   INCL (yyt^."); WI (Class^.Class.Name); WriteS (f, "."); WI (Selector^.Child.Name);
  746.               WriteS (f, "^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ", "); WN (k MOD BSS); WriteS (f, ");"); WriteNl (f);
  747.                END;
  748.             END;
  749.          END;
  750.           END;
  751.        END;
  752.     END;
  753. ;
  754.       RETURN;
  755.      END;
  756.    END;
  757.  
  758.   END;
  759.  END GenS;
  760.  
  761. PROCEDURE GenE (t: Tree.tTree);
  762.  VAR yyTempo: RECORD CASE : INTEGER OF
  763.  | 1: yyR1: RECORD
  764.   ToCompute: tSet;
  765.   END;
  766.  END; END;
  767.  BEGIN
  768.   IF t = Tree.NoTree THEN RETURN; END;
  769.   IF (t^.Kind = Tree.Class) THEN
  770. (* line 484 "" *)
  771.     WITH yyTempo.yyR1 DO
  772.      WITH t^.Class DO
  773. (* line 485 "" *)
  774.       ;
  775. (* line 486 "" *)
  776.           GetIterator (t);
  777.     n := 0;
  778.     j := 2;
  779.     LOOP
  780.        IF j > InstCount THEN EXIT; END;
  781.        WITH Instance^ [j] DO
  782.           IF {Dummy, Output, Test} * Properties # {} THEN
  783.              IF (Test IN Properties) OR
  784.             ({Synthesized, Left} <= Properties) OR
  785.             ({Inherited,  Right} <= Properties) OR
  786.             ({Inherited,   Left} <= Properties) AND
  787.             NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) OR
  788.             ({Synthesized, Right, Dummy} <= Properties) AND (Selector # Iterator) AND
  789.             (HasOutput IN Selector^.Child.Class^.Class.Properties) THEN
  790.             INC (n); EXIT;
  791.          END;
  792.           END;
  793.        END;
  794.        INC (j);
  795.     END;
  796.     IF (n = 0) AND ((Iterator = NoTree) OR NOT (HasOutput IN Iterator^.Child.Class^.Class.Properties)) THEN RETURN; END;
  797.  
  798.     Class := t;
  799.     WriteS (f, "   | "); WI (iMain); WriteS (f, "."); WI (Name); WriteS (f, ":"); WriteNl (f);
  800.     FOR j := 2 TO InstCount DO
  801.        WITH Instance^ [j] DO
  802.           IF {Dummy, Output} * Properties # {} THEN
  803.          IF ({Synthesized, Left} <= Properties) OR
  804.             ({Inherited,  Right} <= Properties) OR
  805.             ({Inherited,   Left} <= Properties) AND
  806.             NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) THEN
  807.             GenCall (t, j);
  808.          ELSIF ({Synthesized, Right, Dummy} <= Properties) AND (Selector # Iterator) AND
  809.             (HasOutput IN Selector^.Child.Class^.Class.Properties) THEN
  810.       IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  811.             WriteS (f, "yyWriteVisit (yyt, '"); WI (Selector^.Child.Name); WriteS (f, "'); "); 
  812.       END;
  813.             WriteS (f, "yyE (yyt^."); WI (Name); WriteS (f, "."); WI (Selector^.Child.Name); WriteS (f, ");"); WriteNl (f);
  814.       IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  815.             WriteS (f, "yyVisitParent (yyt^."); WI (Name); WriteS (f, "."); WI (Selector^.Child.Name); WriteS (f, ");"); WriteNl (f);
  816.       END;
  817.          END;
  818.           END;
  819.        END;
  820.     END;
  821.  
  822.     MakeSet (ToCompute, InstCount);
  823.     FOR i := 2 TO AttrCount DO
  824.        WITH Instance^ [i] DO
  825.           IF Test IN Properties THEN
  826.          FOR j := 2 TO InstCount DO
  827.             IF IsRelated (i, j, DP) THEN
  828.                IF {Synthesized, Inherited} * Instance^ [j].Properties # {} THEN
  829.               Include (ToCompute, j);
  830.                END;
  831.             END;
  832.          END;
  833.           END;
  834.        END;
  835.     END;
  836.     FOR i := 2 TO InstCount DO
  837.        WITH Instance^ [i] DO
  838.           IF ({Synthesized, Left, Output} <= Properties) OR
  839.          ({Inherited,  Right, Output} <= Properties) THEN
  840.          Exclude (ToCompute, i);
  841.           END;
  842.        END;
  843.     END;
  844.     WHILE NOT IsEmpty (ToCompute) DO
  845.        GenCall (t, Extract (ToCompute));
  846.     END;
  847.     ReleaseSet (ToCompute);
  848.     FOR i := 2 TO AttrCount DO
  849.        IF Test IN Instance^ [i].Properties THEN
  850.           GenEvalAttr (t, i);
  851.        END;
  852.     END;
  853.  
  854.     IF (Iterator = NoTree) OR NOT (HasOutput IN Iterator^.Child.Class^.Class.Properties) THEN
  855.        WriteS (f, "RETURN;"); WriteNl (f);
  856.     ELSE
  857.    IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  858.        WriteS (f, "yyWriteVisit (yyt, '"); WI (Iterator^.Child.Name); WriteS (f, "'); "); 
  859.    END;
  860.        WriteS (f, "yyt := yyt^."); WI (Name); WriteS (f, "."); WI (Iterator^.Child.Name); WriteS (f, ";"); WriteNl (f);
  861.     END;
  862. ;
  863.       RETURN;
  864.      END;
  865.     END;
  866.  
  867.   END;
  868.  END GenE;
  869.  
  870. PROCEDURE CompOutput (t: Tree.tTree);
  871.  VAR yyTempo: RECORD CASE : INTEGER OF
  872.  END; END;
  873.  BEGIN
  874.   IF t = Tree.NoTree THEN RETURN; END;
  875.   IF (t^.Kind = Tree.Class) THEN
  876. (* line 576 "" *)
  877.    LOOP
  878.      WITH t^.Class DO
  879. (* line 577 "" *)
  880.       IF NOT (NOT (HasOutput IN Properties)) THEN EXIT; END;
  881. (* line 578 "" *)
  882.       Success := FALSE;
  883. (* line 579 "" *)
  884.       ForallAttributes (t, CompOutput);
  885. (* line 580 "" *)
  886.       ForallClasses (Extensions, CompOutput2);
  887. (* line 581 "" *)
  888.       IF NOT (Success) THEN EXIT; END;
  889. (* line 582 "" *)
  890.       INCL (Properties, HasOutput);
  891. (* line 583 "" *)
  892.       IsStable := FALSE;
  893.       RETURN;
  894.      END;
  895.    END;
  896.  
  897.   END;
  898.   IF (t^.Kind = Tree.Child) THEN
  899. (* line 585 "" *)
  900.    LOOP
  901.      WITH t^.Child DO
  902. (* line 586 "" *)
  903.       IF NOT ((Output IN Properties) OR (HasOutput IN Class ^ . Class . Properties)) THEN EXIT; END;
  904. (* line 587 "" *)
  905.       Success := TRUE;
  906.       RETURN;
  907.      END;
  908.    END;
  909.  
  910.   END;
  911.   IF (t^.Kind = Tree.Attribute) THEN
  912. (* line 589 "" *)
  913.    LOOP
  914.      WITH t^.Attribute DO
  915. (* line 590 "" *)
  916.       IF NOT (({Test, Output} * Properties # {})) THEN EXIT; END;
  917. (* line 591 "" *)
  918.       Success := TRUE;
  919.       RETURN;
  920.      END;
  921.    END;
  922.  
  923.   END;
  924.  END CompOutput;
  925.  
  926. PROCEDURE CompOutput2 (t: Tree.tTree);
  927.  VAR yyTempo: RECORD CASE : INTEGER OF
  928.  END; END;
  929.  BEGIN
  930.   IF t = Tree.NoTree THEN RETURN; END;
  931.   IF (t^.Kind = Tree.Class) THEN
  932. (* line 596 "" *)
  933.    LOOP
  934.      WITH t^.Class DO
  935. (* line 597 "" *)
  936.       IF NOT (HasOutput IN Properties) THEN EXIT; END;
  937. (* line 598 "" *)
  938.       Success := TRUE;
  939.       RETURN;
  940.      END;
  941.    END;
  942.  
  943.   END;
  944.  END CompOutput2;
  945.  
  946. PROCEDURE ToBit0 (yyP2: Tree.tTree; yyP1: INTEGER): INTEGER;
  947.  VAR yyTempo: RECORD CASE : INTEGER OF
  948.  END; END;
  949.  BEGIN
  950. (* line 602 "" *)
  951.       RETURN yyP2 ^ . Class . BitIndex ^ [yyP1] . ToBit - 1;
  952.  
  953.  END ToBit0;
  954.  
  955. PROCEDURE ToBit1 (yyP4: Tree.tTree; yyP3: INTEGER): INTEGER;
  956.  VAR yyTempo: RECORD CASE : INTEGER OF
  957.  END; END;
  958.  BEGIN
  959. (* line 605 "" *)
  960.       RETURN yyP4 ^ . Child . Class ^ . Class . BitIndex ^ [yyP3] . ToBit - 1;
  961.  
  962.  END ToBit1;
  963.  
  964. PROCEDURE ToBit2 (yyP7: Tree.tTree; yyP6: Tree.tTree; yyP5: SHORTCARD): INTEGER;
  965.  VAR yyTempo: RECORD CASE : INTEGER OF
  966.  | 1: yyR1: RECORD
  967.   yyV1: INTEGER;
  968.   END;
  969.  END; END;
  970.  BEGIN
  971. (* line 608 "" *)
  972.     WITH yyTempo.yyR1 DO
  973. (* line 609 "" *)
  974.         WITH yyP6^.Child DO
  975.       RETURN yyP7^.Class.BitCount + BitOffset +
  976.      Class^.Class.BitIndex^ [yyP5 - yyP7^.Class.AttrCount - InstOffset].ToBit - 1;
  977.    END;
  978. ;
  979.       RETURN yyV1;
  980.     END;
  981.  
  982.  END ToBit2;
  983.  
  984. PROCEDURE ToAttr (yyP9: Tree.tTree; yyP8: INTEGER): INTEGER;
  985. (* line 616 "" *)
  986.  VAR a: SHORTCARD; 
  987.  VAR yyTempo: RECORD CASE : INTEGER OF
  988.  | 1: yyR1: RECORD
  989.   yyV1: INTEGER;
  990.   END;
  991.  END; END;
  992.  BEGIN
  993. (* line 617 "" *)
  994.     WITH yyTempo.yyR1 DO
  995. (* line 618 "" *)
  996.         WITH yyP9^.Class DO
  997.       FOR a := AttrCount + 1 TO InstCount DO
  998.      WITH Instance^ [a] DO
  999.         IF ({Input, Test, Dummy} * Properties = {}) AND
  1000.            (ToBit2 (yyP9, Selector, a) = yyP8) THEN RETURN a; END;
  1001.      END;
  1002.       END;
  1003.    END;
  1004.    RETURN 0;
  1005. ;
  1006.       RETURN yyV1;
  1007.     END;
  1008.  
  1009.  END ToAttr;
  1010.  
  1011. PROCEDURE GenEvaluator (t: Tree.tTree);
  1012.  VAR yyTempo: RECORD CASE : INTEGER OF
  1013.  | 9: yyR9: RECORD
  1014.   TheClass: Tree.tTree;
  1015.   k: INTEGER;
  1016.   END;
  1017.  END; END;
  1018.  BEGIN
  1019.   IF t = Tree.NoTree THEN RETURN; END;
  1020.  
  1021.   CASE t^.Kind OF
  1022.   | Tree.Assign:
  1023. (* line 631 "" *)
  1024.      WITH t^.Assign DO
  1025. (* line 633 "" *)
  1026.       GenEvaluator (Arguments);
  1027.       RETURN;
  1028.      END;
  1029.  
  1030.   | Tree.Copy:
  1031. (* line 631 "" *)
  1032.      WITH t^.Copy DO
  1033. (* line 633 "" *)
  1034.       GenEvaluator (Arguments);
  1035.       RETURN;
  1036.      END;
  1037.  
  1038.   | Tree.TargetCode:
  1039. (* line 635 "" *)
  1040.      WITH t^.TargetCode DO
  1041. (* line 636 "" *)
  1042.       GenEvaluator (Code);
  1043.       RETURN;
  1044.      END;
  1045.  
  1046.   | Tree.Check:
  1047. (* line 638 "" *)
  1048.      WITH t^.Check DO
  1049. (* line 639 "" *)
  1050.       GenEvaluator (Condition);
  1051. (* line 640 "" *)
  1052.       GenEvaluator (Statement);
  1053. (* line 641 "" *)
  1054.       GenEvaluator (Actions);
  1055.       RETURN;
  1056.      END;
  1057.  
  1058.   | Tree.Designator:
  1059. (* line 643 "" *)
  1060.      WITH t^.Designator DO
  1061. (* line 647 "" *)
  1062.       GenEvaluator (Next);
  1063.       RETURN;
  1064.      END;
  1065.  
  1066.   | Tree.Ident:
  1067. (* line 643 "" *)
  1068.      WITH t^.Ident DO
  1069. (* line 647 "" *)
  1070.       GenEvaluator (Next);
  1071.       RETURN;
  1072.      END;
  1073.  
  1074.   | Tree.Any:
  1075. (* line 643 "" *)
  1076.      WITH t^.Any DO
  1077. (* line 647 "" *)
  1078.       GenEvaluator (Next);
  1079.       RETURN;
  1080.      END;
  1081.  
  1082.   | Tree.Anys:
  1083. (* line 643 "" *)
  1084.      WITH t^.Anys DO
  1085. (* line 647 "" *)
  1086.       GenEvaluator (Next);
  1087.       RETURN;
  1088.      END;
  1089.  
  1090.   | Tree.Remote:
  1091. (* line 649 "" *)
  1092.     WITH yyTempo.yyR9 DO
  1093.      WITH t^.Remote DO
  1094. (* line 650 "" *)
  1095.       ;
  1096. (* line 650 "" *)
  1097.       ;
  1098. (* line 651 "" *)
  1099.       TheClass := IdentifyClass (TreeRoot ^ . Ag . Classes, Type);
  1100. (* line 652 "" *)
  1101.         IF TheClass # NoTree THEN
  1102.       Attr := IdentifyAttribute (TheClass, Attribute);
  1103.       IF Attr # NoTree THEN
  1104.      WITH Attr^.Attribute DO
  1105.         k := ToBit0 (TheClass, AttrIndex);
  1106.         IF Synthesized IN Properties THEN
  1107.            WriteS (f, "IFNOTIN ("); WN (k MOD BSS); WriteS (f, ","); EvalMod.GenEvaluator (Designators);
  1108.            WriteS (f, "^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ") yyS"); WN (k); WriteS (f, " ("); 
  1109.            EvalMod.GenEvaluator (Designators); WriteS (f, "); END;"); WriteNl (f);
  1110.         ELSIF Inherited IN Properties THEN
  1111.            WriteS (f, "IFNOTIN ("); WN (k MOD BSS); WriteS (f, ","); EvalMod.GenEvaluator (Designators);
  1112.            WriteS (f, "^.yyHead.yyIsComp"); WN (k DIV BSS); WriteS (f, ") yyI ["); 
  1113.            EvalMod.GenEvaluator (Designators); WriteS (f, "^.yyHead.yyOffset + "); WN (k);
  1114.            WriteS (f, "]("); EvalMod.GenEvaluator (Designators); WriteS (f, "^.yyHead.yyParent); END;"); WriteNl (f);
  1115.         END;
  1116.      END;
  1117.       END;
  1118.    END;
  1119.    GenEvaluator (Next);
  1120. ;
  1121.       RETURN;
  1122.      END;
  1123.     END;
  1124.  
  1125.   ELSE END;
  1126.  
  1127.  END GenEvaluator;
  1128.  
  1129. PROCEDURE BeginEvalMod3;
  1130.  BEGIN
  1131.  END BeginEvalMod3;
  1132.  
  1133. PROCEDURE CloseEvalMod3;
  1134.  BEGIN
  1135.  END CloseEvalMod3;
  1136.  
  1137. PROCEDURE yyExit;
  1138.  BEGIN
  1139.   IO.CloseIO; System.Exit (1);
  1140.  END yyExit;
  1141.  
  1142. BEGIN
  1143.  yyf    := IO.StdOutput;
  1144.  Exit    := yyExit;
  1145.  BeginEvalMod3;
  1146. END EvalMod3.
  1147.